home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Network Supervisor's Toolkit
/
Network Supervisor's Toolkit.iso
/
tools
/
nwtp06
/
fget.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-07-10
|
6KB
|
201 lines
{$X+,V-,B-,I-}
program Fget; { Listening Process / receiver / Slave }
{ Testprogram for the nwPEP unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
{$DEFINE noTRACE}
uses crt,nwMisc,nwIPX,nwPEP;
Var ListenECB :Tecb; { used to listen for packets }
ListenPepHdr :TpepHeader;
SendECB :Tecb; { used to send acknowledgements }
SendPepHdr :TpepHeader;
IOsocket :word;
DataBuffer :array[1..546] of byte;
SendDataBuffer:byte;
PacketReceived :Boolean;
LastTransactionID:LongInt;
NewStack:array[1..8192] of word; { !! used by ESR }
StackBottom:word; { !! used by ESR }
Procedure CheckError(err:boolean; errNbr:word);
begin
if err
then begin
CASE errNbr of
$0100:writeln('IPX needs to be installed.');
$0101:writeln('ERROR: Connection not established. A Timeout occured');
$0102:writeln('ERROR: The transfer is aborted; A timeout occured.');
$0108:writeln('Transfer aborted.');
$0300:writeln('The supplied path doesn'' exist / no write rights in directory.');
$0301:writeln('Error writing to file / no write rights in directory.');
$10FE:writeln('Error opening socket: Socket Table Is Full.');
$10FF:writeln('Error opening socket: Socket is already open.');
else writeln('Unspecified error.');
end; {case}
IPXcloseSocket(IOsocket);
halt(1);
end;
end;
Function TimeOut(t1,t2:word;n:byte):boolean;
{ ticks t2 - ticks t1 > n seconds ? }
Var lt1,lt2:LongInt;
begin
lt2:=t2;
if t1>t2 then lt2:=lt2+$FFFF;
TimeOut:=(lt2-t1)>(n*18);
end;
{$F+}
Procedure ListenAndAckHandler;
begin
If (ListenECB.CompletionCode<>0)
or (ListenPepHdr.IPXhdr.packetType<>PEP_PACKET_TYPE)
or (ListenPepHdr.clienttype<>$EA)
or (ListenPepHdr.TransactionID<LastTransactionID) { discard dupe old packet }
then IPXlistenForPacket(ListenECB)
else begin
PacketReceived:=(ListenPepHdr.transactionID>LastTransactionID); { new packet received }
{ Acknowledge new packets and duplicates of the latest packet, }
{ as the original acknowledgement may have been lost. }
LastTransactionID:=ListenPepHdr.TransactionID;
{ Setup acknowledgement ECB and PEPheader, and send it. }
if SendECB.InUseFlag=0
then begin
ListenPepHdr.IPXhdr.source.socket:=swap(ListenPepHdr.IPXhdr.source.socket);
{ socket is hi-lo in IPX/PEPHeaders. SetupSendECB expects lo-hi }
PEPsetupSendECB(NIL,IOsocket,ListenPepHdr.IPXhdr.source,
@SendDataBuffer,0,
SendPepHdr,SendECB);
SendPepHdr.TransactionId:=LastTransactionID;
SendPepHdr.ClientType:=$EA;
IPXsendPacket(SendECB);
end;
end;
end;
{$F-}
{$F+}
Procedure ListenAndAckESR; assembler;
asm
mov dx, seg stackbottom
mov ds, dx
mov dx,ss { setup of a new local stack }
mov bx,sp { ss:sp copied to dx:bx}
mov ax,ds
mov ss,ax
mov sp,offset stackbottom
push dx { push old ss:sp on new stack }
push bx
CALL ListenAndAckHandler
pop bx { restore ss:sp from new stack }
pop dx
mov sp,bx
mov ss,dx
end;
{$F-}
Var ticks,ticks2 :word;
FileName:string;
FileSize:LongInt;
DirName:string;
f:file;
BytesToWrite,BytesWritten:word;
begin
IpxInitialize;
CheckError(nwIPX.result>0,$100);
If (pos('?',ParamStr(1))>0) or (paramcount>1)
then begin
writeln('Usage: FGET <directory>');
writeln('-The File sent by FSEND on another workstation');
writeln('will be copied to the supplied directory.');
halt(1);
end;
If paramcount=1
then DirName:=ParamStr(1)
else DirName:='.';
IF NOT (DirName[ord(dirName[0])] IN [':','\'])
then DirName:=DirName+'\';
assign(f,DirName+'temp.$$$');
rewrite(f,1);
CheckError(IOresult<>0,$0300);
close(f);
IOSocket:=$5678;
IPXopenSocket(IOsocket,SHORT_LIVED_SOCKET);
CheckError(nwIPX.result>0,$1000+nwIPX.result);
{ Setup of ECB and PepHeader, start listening for incoming packets. }
LastTransactionID:=0;
PacketReceived:=False;
PEPSetupListenECB(Addr(ListenAndAckESR),IOsocket,@DataBuffer,546,
ListenPepHdr,ListenECB);
IPXListenForPacket(ListenECB);
writeln('Waiting for FSEND to start sending.. (any key to abort)');
IPXGetIntervalMarker(ticks);
REPEAT
IPXrelinquishControl;
IPXGetIntervalMarker(ticks2);
CheckError(TimeOut(ticks,ticks2,130),$101);{ error if a timeout occurred }
CheckError(Keypressed,$108);
UNTIL PacketReceived;
writeln('Handshaking.. Initiating transfer process.');
{$IFDEF TRACE}
writeln('Received PacketID:',LastTransactionID);
{$ENDIF}
{ do something with DataBuffer: the data that was just received. }
{ the first packet contains the filename and filesize }
Move(DataBuffer[1],FileName[0],15);
Move(DataBuffer[16],FileSize,4);
writeln('Receiving file ',FileName,', size: ',FileSize);
assign(f,DirName+filename);
rewrite(f,1);
BytesToWrite:=512;
REPEAT { Listen for remaining packets }
Packetreceived:=false;
While SendECB.InuseFlag<>0
do IPXrelinquishControl;
IPXListenForPacket(ListenECB);
IPXGetIntervalMarker(ticks);
Repeat
IPXrelinquishControl;
IPXGetIntervalMarker(ticks2);
CheckError(TimeOut(ticks,ticks2,10),$102); { error if Timeout occurred }
CheckError(Keypressed,$108);
until PacketReceived;
{$IFDEF TRACE}
writeln('Received packet#:',LastTransactionID);
{$ENDIF}
{ Write DataBuffer to disk. }
IF FileSize<512
then BytesToWrite:=FileSize;
BlockWrite(f,DataBuffer,BytesToWrite,BytesWritten);
CheckError(BytesToWrite<>BytesWritten,$0301);
FileSize:=FileSize-512;
UNTIL (FileSize<=0); { entire file received }
writeln('Transfer complete.');
IPXcloseSocket(IOsocket);
close(f);
end.